home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TIMING.SWG / 0001_Millisecond Timer Unit.pas next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  94 lines
  1. { millisecond timer Unit }
  2.  
  3. Unit msecs;
  4.  
  5. Interface
  6.  
  7. Var
  8.    timer:Word;                     { msec timer }
  9.    idle:Procedure; {  you can change this to do something useful when Delaying}
  10.  
  11. Procedure Delay_ticks(t:Word);     { resume Until t clock ticks have elapsed }
  12. Procedure start_clock;             { starts the 1 msec timer }
  13. Procedure stop_clock;              { stops the 1 msec timer }
  14.  
  15. Implementation
  16.  
  17. Uses Dos;
  18.  
  19. Procedure Delay_ticks(t:Word);
  20. begin
  21.   inc(t,timer);
  22.   Repeat idle Until Integer(timer - t) >= 0;
  23. end;
  24.  
  25. Const clock_active:Boolean = False;
  26.       one_msec = 1193;
  27. Var   save_clock:Pointer;
  28.       clocks:Word;
  29.  
  30. Procedure tick_int; Far; Assembler;
  31. Asm
  32.   push ax
  33.   push ds
  34.   mov ax,seg @data
  35.   mov ds,ax
  36.   mov al,$20
  37.   out $20,al
  38.   inc [timer]
  39.   add [clocks],one_msec
  40.   jnc @1
  41.   pushf
  42.   call [save_clock]
  43. @1:
  44.   pop ds
  45.   pop ax
  46.   iret
  47. end;
  48.  
  49.  
  50. Procedure start_clock;
  51. begin
  52.   if clock_active then Exit;
  53.   inc(clock_active);
  54.   timer := 0;
  55.   clocks := 0;
  56.   getintvec($08,save_clock);
  57.   setintvec($08,@tick_int);
  58.   port[$43] := $36;
  59.   port[$40] := lo(one_msec);
  60.   port[$40] := hi(one_msec);
  61. end;
  62.  
  63. Procedure stop_clock;
  64. begin
  65.   if not clock_active then Exit;
  66.   dec(clock_active);
  67.   port[$43] := $36;
  68.   port[$40] := 0;
  69.   port[$40] := 0;
  70.   setintvec($08,save_clock);
  71. end;
  72.  
  73. Procedure nothing; Far;
  74. begin
  75. end;
  76.  
  77. Var saveexit:Pointer;
  78.  
  79. Procedure uninstall; Far;
  80. begin
  81.   Exitproc := saveexit;
  82.   if clock_active then stop_clock;
  83. end;
  84.  
  85. begin
  86.   timer := 0;
  87.   idle := nothing;
  88.   saveexit := Exitproc;
  89.   Exitproc := @uninstall;
  90. end.
  91.  
  92.  
  93.  
  94.